home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 43 / Amiga Format CD43 (1999)(Future Publishing)(GB)(Track 1 of 2)[!][issue 1999-09].iso / -serious- / comms / other / hserv / main / hs.rexx < prev    next >
OS/2 REXX Batch file  |  1999-06-14  |  28KB  |  980 lines
  1. /* hs.rexx - single connection handler */
  2.  
  3. signal on syntax
  4. signal on error
  5.  
  6. /**init **/
  7. call getSocket
  8. call init
  9.  
  10. /**get peer info**/
  11. if ~getPeerInfo() then call errorAnswer(403,"Sorry,<br>you are not welcome here.")
  12.  
  13. /**read request **/
  14. res=timedReadRequest()
  15. if res~=0 then call errorAnswer(res)
  16.  
  17. /**check status**/
  18. if ~getVirtualHost() then call errorAnswer(503)
  19.  
  20. /**check status**/
  21. if global.status="PAUSED" then
  22.     call errorAnswer(503,"Sorry <"global.peer">,<br>This service is temporarily unavaible.")
  23.  
  24. /**check Ident service**/
  25. if ~checkIdent() then
  26.     call errorAnswer(420,"Sorry <"global.peer">,<br>you must have the ident service running to access this site.")
  27.  
  28. /**log request**/
  29. if global.TransferLog~="OFF" then
  30.     call transferLog("connection from" global.userat "Method:" global.method "Request:" global.file)
  31.  
  32. /**admin pure racism test**/
  33. if global.OnlyAmigaClient="ON" & pos("AMIGA",upper(global.client))=0 then
  34.     call errorAnswer(403,"Sorry <"global.useratHTML">,<br>only Amiga clients are welcome here.")
  35.  
  36. /**check k-lines**/
  37. res=checkIP()
  38. if res~="" then
  39.     call errorAnswer(403,"Sorry <"global.useratHTML">,<br>you are not welcome here:" res)
  40.  
  41. /**now we can send the def.image**/
  42. global.ErrorImage=global.DefImage=="ON"
  43.  
  44. /**parse file**/
  45. res=parseFileName()
  46. if res~=0 then do
  47.     select
  48.         when res=-1 then nop
  49.         when res=404 then call errorAnswer(404,"File" global.file "not found.<br><br>Mail the system admin if you think that's not correct.")
  50.         otherwise call errorAnswer(res)
  51.     end
  52. end
  53.  
  54. /**check Auth**/
  55. res=checkAuth()
  56. if res~="" then do
  57.     call sen createHead(401,"text/html",,res) || "<html><head><title>hserv Auth Error</title></head><body><img src=http://"hostName()"/def.gif ALT=def.gif><br><br><hr><br><h2>Sorry <"global.useratHTML">,<br>you don't have access to" '"'res'".</h2></body></html>'
  58.     exit
  59. end
  60.  
  61. /**methods**/
  62. select
  63.     when global.method="GET" then do
  64.         if global.since~="" then
  65.             if ~checkSince(global.since,global.complete) then call errorAnswer(304)
  66.         if global.handler="SEND" then call timedSendFile(global.complete,0,0,200)
  67.         else call doCGI
  68.     end
  69.     when global.method="POST" then call doCGI
  70.     when global.method="HEAD" then call timedSendFile(global.complete,1,0,200)
  71.     otherwise call errorAnswer(400)
  72. end
  73. exit
  74. /***************************************************************************/
  75. getSocket: procedure expose global.
  76.     global.sock=LastSocket()
  77.     if global.sock=-1 then do
  78.         call EasyRequest("hs can only be started by hserv .")
  79.         exit
  80.     end
  81.     return
  82. /***************************************************************************/
  83. init: procedure expose global.
  84.     call ReadConfig
  85.     call pragma("D",global.RootDir)
  86.     call pragma("P",global.Pri)
  87.     global.ErrorImage=0
  88.     global.defMime="text/plain"
  89.     global.inetDate="%m %w %d %Y %H:%M:%S GMT"
  90.     global.err5=0
  91.     global.timer=CreateTimer()
  92.     global.timers=TimerSignal(global.timer)
  93.     call SetSocketSignals(global.timers)
  94.     return
  95. /***************************************************************************/
  96. doCGI: procedure expose global.
  97.     f=exCGI(global.complete,global.args,global.handler)
  98.     if f~="" then call timedSendFile(f,0,1,200)
  99.     return
  100. /***************************************************************************/
  101. sen: procedure expose global.
  102. parse arg string
  103.     res=send(global.sock,string)
  104.     if res~=length(string) then call ErrLog("error seanding %m" global.peer)
  105.     return
  106. /***************************************************************************/
  107. timedReadRequest: procedure expose global.
  108.     call StartTimer(global.timer,global.timeout)
  109.     res=readRequest()
  110.     call StopTimer(global.timer)
  111.     return res
  112. /***************************************************************************/
  113. readRequest: procedure expose global.
  114.     head=""
  115.     do try=0 to 1 while head=""
  116.         if recvline(global.sock,"HEAD",256)<0 then do
  117.             if errno()=4 then return 410
  118.             else call ErrLog("error reading %m" global.peer)
  119.             return 500
  120.         end
  121.     end
  122.     if try=2 then do
  123.         call ErrLog("empty request" global.peer)
  124.         exit
  125.     end
  126.     if words(head)~=3 then return 400
  127.  
  128.     parse var head global.method" "global.file" HTTP/"maior"."minor
  129.     if maior<1 then return 505
  130.  
  131.     global.since=""
  132.     global.authorization=""
  133.     global.ContentLength=""
  134.     global.client=""
  135.     global.range=""
  136.     global.RKeepAlive=""
  137.     global.Host=""
  138.  
  139.     stop=0
  140.     do k=0 to 20 while ~stop
  141.         if recvline(global.sock,"LINE",256)<0 then do
  142.             if errno()=4 then return 410
  143.             else do
  144.                 call ErrLog("error reading %m" global.peer)
  145.                 return 500
  146.             end
  147.         end
  148.         else
  149.             if line~="D0A"x then do
  150.                 parse var line f": "rest "D"x
  151.                 f=upper(f)
  152.                 select
  153.                     when  f="IF-MODIFIED-SINCE" then global.since=rest
  154.                     when  f="AUTHORIZATION" then parse var rest "Basic "global.authorization .
  155.                     when  f="CONTENT-LENGTH" then global.ContentLength=rest
  156.                     when  f="USER-AGENT" then global.client=rest
  157.                     when  f="RANGE" then global.range=rest
  158.                     when  f="KEEPALIVE" then global.RKeepAlive=rest
  159.                     when  f="HOST" then global.Host=rest
  160.                     otherwise nop
  161.                 end
  162.                 global.request.k=line
  163.                 call SetVar(f,rest,"LOCAL")
  164.             end
  165.             else stop=1
  166.     end
  167.     if global.host="" then global.host=hostName()":"global.port
  168.     parse var global.host global.host":" global.hostport .
  169.     if global.hostport="" then global.hostport=global.port
  170.     else if global.hostport~=global.port then return 400
  171.  
  172.     global.request.num=k-1
  173.  
  174.     if global.method="POST" then do
  175.         if global.ContentLength~="" then pl=global.ContentLength
  176.         else return 411
  177.         if pl>1024 then return 406
  178.         len=recv(global.sock,"BUF",pl)
  179.         if len<0 then do
  180.             if errno()=4 then return 410
  181.             call ErrLog("error reading %m" global.peer)
  182.             return 500
  183.         end
  184.         if pl~=len then return 410
  185.         parse var buf global.args"D"x
  186.     end
  187.     return 0
  188. /***************************************************************************/
  189. readConfig: procedure expose global.
  190.     global.RootDir=PathPart(ProgramName("FULL"))
  191.     global.HostName=GetVar("hserv_HostName","LOCAL")
  192.     global.admin=GetVar("hserv_Admin","LOCAL")
  193.     global.ver=GetVar("hserv_Ver","LOCAL")
  194.     global.port=GetVar("hserv_Port","LOCAL")
  195.     global.VirtualHosts=GetVar("hserv_VirtualHosts","LOCAL")
  196.     global.DocumentDir=GetVar("hserv_DocumentDir","LOCAL")
  197.     global.DocumentIndex=GetVar("hserv_DocumentIndex","LOCAL")
  198.     global.CGIDir=GetVar("hserv_CgiDir","LOCAL")
  199.     global.ErrorLog=GetVar("hserv_ErrorLog","LOCAL")
  200.     global.ErrorFile=GetVar("hserv_ErrorFile","LOCAL")
  201.     global.TransferLog=GetVar("hserv_TransferLog","LOCAL")
  202.     global.TransferFile=GetVar("hserv_TransferFile","LOCAL")
  203.     global.auth=GetVar("hserv_Auth","LOCAL")
  204.     global.KeepAlive=GetVar("hserv_KeepAlive","LOCAL")
  205.     global.KeepAliveTimeout=GetVar("hserv_KeepAliveTimeout","LOCAL")
  206.     global.Timeout=GetVar("hserv_Timeout","LOCAL")
  207.     global.RejectedIP=GetVar("hserv_RejectedIP","LOCAL")
  208.     if global.RejectedIP="" then
  209.         global.HostNameLookups=GetVar("hserv_HostNameLookups","LOCAL")
  210.     else global.HostNameLookups="ON"
  211.     global.MimeFile=GetVar("hserv_MimeFile","LOCAL")
  212.     global.OnlyAmigaClient=GetVar("hserv_OnlyAmigaClient","LOCAL")
  213.     global.DefImage=GetVar("hserv_DefImage","LOCAL")
  214.     global.ident=GetVar("hserv_Ident","LOCAL")
  215.     global.pri=GetVar("hserv_Pri","LOCAL")
  216.     global.status=GetVar("hserv_Status","LOCAL")
  217.     global.Specials=GetVar("hserv_Specials","LOCAL")
  218.     global.Handlers=GetVar("hserv_Handlers","LOCAL")
  219.     global.Errors=GetVar("hserv_Errors","LOCAL")
  220.     return
  221. /***************************************************************************/
  222. getPeerInfo: procedure expose global.
  223.     if GetPeerName(global.sock,"GLOBAL")<0 then do
  224.         call ErrLog("can't get peer info %m")
  225.         return 0
  226.     end
  227.     global.peer=global.addrAddr
  228.     global.peerPort=global.addrPort
  229.     if global.HostNameLookups="ON" then
  230.         if GetHostByAddr("HOST",global.addrAddr) then global.peer=host.hostName
  231.         else return 0
  232.     return 1
  233. /***************************************************************************/
  234. authFun: procedure
  235. parse arg ha, lp, sp
  236.     sock=socket("INET","STREAM")
  237.     if sock<0 then return "-ERR" errno()
  238.  
  239.     sin.addrAddr=ha
  240.     sin.addrPort=113
  241.     if connect(sock,"SIN")<0 then do
  242.         call CloseSocket(sock)
  243.         return "-ERR" errno()
  244.     end
  245.  
  246.     request=sp","lp"D0A"x
  247.     if send(sock,request)<0 then do
  248.         call CloseSocket(sock)
  249.         return "-ERR" errno()
  250.     end
  251.     ans=""
  252.     len=recv(sock,"BUF",256)
  253.     do while len>0
  254.         ans=ans || buf
  255.         len=recv(sock,"BUF",256)
  256.     end
  257.     call CloseSocket(sock)
  258.     if len<0 then return "-ERR" errno()
  259.  
  260.     if index(ans,"ERROR")~=0 then do
  261.         parse var ans "ERROR:" rest
  262.         return "+OK unknown"
  263.     end
  264.     parse var ans ans"D0A"x
  265.     return "+OK "ans
  266. /***************************************************************************/
  267. checkIdent: procedure expose global.
  268.     if global.ident="ON" then do
  269.         auth=AuthFun(global.addrAddr,global.port,global.addrPort)
  270.         if left(auth,4)="-ERR" then do
  271.             call ErrLog("can't get ident info for" global.peer)
  272.             return 0
  273.         end
  274.         else parse var auth"+OK" rp "," lp ": USERID : " sis " : " global.user
  275.         global.useratHTML=global.user"@"global.peer
  276.         global.userat="<"global.useratHTML":"global.peerPort">"
  277.     end
  278.     else do
  279.         global.user=""
  280.         global.useratHTML=global.peer
  281.         global.userat="<"global.useratHTML":"global.peerPort">"
  282.     end
  283.     return 1
  284. /***************************************************************************/
  285. errorAnswer: procedure expose global.
  286. parse arg code,h
  287.     if global.errors~="" then do
  288.         lines=ParseConfig(global.errors,"ERRORS","NOUPPER")
  289.         if lines==-1 then do
  290.             call ErrLog("Errors file '"global.Errors"' not found")
  291.             exit
  292.         end
  293.         do i=0 to lines-1
  294.             if errors.i~=code then iterate
  295.             parse var errors.i.value macro newcode .
  296.             if newcode="" then newcode=code
  297.             f=exCGI(macro,newcode global.file,getHandler(macro))
  298.             call timedSendFile(f,0,1,newcode)
  299.             exit
  300.         end
  301.     end
  302.     else do
  303.         msg=createHead(code,"text/html")
  304.         if h~="" then do
  305.             msg=msg"<head><title>hserv error</title></head><body>"
  306.             if global.ErrorImage=1 then
  307.                 msg=msg"<img src=http://"hostName()"/def.gif ALT=def.gif>"
  308.             else
  309.                 msg=msg"<h1><strong>hserv "global.ver"</strong></h1>"
  310.             msg=msg"<br><br><hr><br><h2>" h "</h2></body>"
  311.         end
  312.         call sen msg
  313.     end
  314.     exit
  315. /***************************************************************************/
  316. timedSendFile: procedure expose global.
  317.     parse arg complete,head,cgi,code
  318.     call StartTimer(global.timer,global.Timeout)
  319.     call sendFile(complete,head,cgi,code)
  320.     call StopTimer(global.timer)
  321.     return
  322. /***************************************************************************/
  323. sendFile: procedure expose global.
  324. parse arg complete,head,cgi,code
  325.     resume=0
  326.     f=0
  327.     if ~cgi then t=global.size-1
  328.     delta=1024
  329.  
  330.     if ~open("IN",complete,"R") then do
  331.         call ErrLog("unable to open" complete global.peer)
  332.         call errorAnswer(404)
  333.     end
  334.  
  335.     if cgi then do
  336.         mime=ReadLN("IN")
  337.         call ReadLN("IN")
  338.         length=""
  339.         last=""
  340.     end
  341.     else do
  342.         mime=getMime(complete)
  343.         last=GMTInetFileDate(complete)
  344.         length=global.size
  345.     end
  346.  
  347.     if cgi | pos("text",mime)~=0 then length=""
  348.     else
  349.         if global.range~="" then do
  350.             parse var global.range "bytes="ff"-"tt","d1 d2
  351.             if ff="" then ff=f
  352.             if tt="" then tt=t
  353.             if d1="" & d2="" & tt<global.size & tt-ff<global.size & Datatype(ff,"N") & Datatype(tt,"N") & ff>=0 & ff<=tt then do
  354.                 resume=1
  355.                 code=206
  356.                 f=ff
  357.                 t=tt
  358.                 length=t-f+1
  359.                 if length=1 then delta=1
  360.                 else
  361.                     do while delta>length
  362.                         delta=delta%2
  363.                     end
  364.             end
  365.         end
  366.  
  367.     ss=createHead(code,mime,length,"",last,cgi)
  368.  
  369.     if head then do
  370.         call close("IN")
  371.         call sen ss
  372.         return
  373.     end
  374.  
  375.     if ~cgi then call Seek("IN",f,"BEGIN")
  376.  
  377.     a=readch("IN",delta)
  378.     if a="" then do
  379.         call ErrLog("error file" complete "is empty" global.peer)
  380.         call errorAnswer(500)
  381.     end
  382.  
  383.     sent=length(a)
  384.     if length="" then a=parseText(a)
  385.     a=ss||a
  386.     res=send(global.sock,a)
  387.     if res~=length(a) then do
  388.         if errno()~=4 then
  389.             call ErrLog("error seanding %m" global.peer)
  390.         return
  391.     end
  392.     do while ~eof("IN")
  393.         if resume then if sent>=length then leave
  394.         a=readch("IN",delta)
  395.         if a~="" then do
  396.             l=length(a)
  397.             if resume then do
  398.                 if l+sent>length then do
  399.                     l=length-l
  400.                     a=left(a,l)
  401.                 end
  402.             end
  403.             sent=sent+l
  404.             if length="" then a=parseText(a)
  405.             if res<send(global.sock,a) then do /* it should be ~=l , but ... */
  406.                 if errno()~=4 then
  407.                     call ErrLog("error seanding %m" global.peer res l)
  408.                 return
  409.             end
  410.         end
  411.     end
  412.     call close("IN")
  413.     return
  414. /***************************************************************************/
  415. parseText: procedure expose global.
  416. parse arg a
  417.  
  418.     stop=0
  419.     do while ~stop
  420.         select
  421.  
  422.             when index(a,"<!include ")~=0 then do
  423.                 parse var a a "<!include " file ">" b
  424.                 a=a || include(file) || b
  425.             end
  426.  
  427.             when index(a,"<!--#INCLUDE FILE=")~=0 then do
  428.                 parse var a a "<!--#INCLUDE FILE=" file "-->" b
  429.                 a=a || include(file) || b
  430.             end
  431.  
  432.             when index(a,"<!ip>")~=0 then do
  433.                 parse var a a "<!ip>" b
  434.                 a=a || global.peer || b
  435.             end
  436.  
  437.             when index(a,"<!userat>")~=0 then do
  438.                 parse var a a "<!userat>" b
  439.                 a=a || global.useratHTML || b
  440.             end
  441.  
  442.             when index(a,"<!user>")~=0 then do
  443.                 parse var a a "<!user>" b
  444.                 a=a || global.user || b
  445.             end
  446.  
  447.             when index(a,"<!power>")~=0 then do
  448.                 parse var a a "<!power>" b
  449.                 a=a || "Powered Up with <B>rxsocket.library</B>!" || b
  450.             end
  451.  
  452.             when index(a,"<!this>")~=0 then do
  453.                 parse var a a "<!this>" b
  454.                 a=a || global.complete || b
  455.             end
  456.  
  457.             when index(a,"<!InetDate>")~=0 then do
  458.                 parse var a a "<!InetDate>" b
  459.                 a=a || GMTInetCurrentDate() || b
  460.             end
  461.  
  462.             when index(a,"<!ver>")~=0 then do
  463.                 parse var a a "<!ver>" b
  464.                 a=a || "hserv" global.ver || b
  465.             end
  466.  
  467.             when index(a,"<!admin>")~=0 then do
  468.                 parse var a a "<!admin>" b
  469.                 a=a || '<A HREF="mailto:'global.admin'">'global.admin'</A>' || b
  470.             end
  471.  
  472.             when index(a,"<!REXX ")~=0 then do
  473.                 parse var a a "<!REXX " fun ">" b
  474.                 p=PathPart(fun)
  475.                 if p~="" then old=pragma("D",p)
  476.                 else old=pragma("D",global.CGIDir)
  477.                 INTERPRET "res="fun
  478.                 old=pragma("D",old)
  479.                 a=a || res || b
  480.             end
  481.  
  482.             otherwise do
  483.                 stop=1
  484.             end
  485.         end
  486.     end
  487.  
  488.     stop=0
  489.     do while ~stop
  490.  
  491.         select
  492.  
  493.             when index(a,"<!CGI ")~=0 then do
  494.                 parse var a a "<!CGI " fun arg">" b
  495.                 macro=AddPart(global.CGIDir,fun)
  496.                 f=exCGI(macro,arg,getHandler(macro))
  497.                 if f~="" then
  498.                     if open("CGI",f,"READ") then do
  499.                         l=ReadLn("CGI")
  500.                         call ReadLn("CGI")
  501.                         do while ~eof("CGI")
  502.                             l=ReadLn("CGI")
  503.                             if l~="" then a=a||l
  504.                         end
  505.                         call Close("CGI")
  506.                     end
  507.                 a=a||b
  508.             end
  509.  
  510.             otherwise stop=1
  511.         end
  512.     end
  513.  
  514.     return a
  515. /***************************************************************************/
  516. exCGI: procedure expose global.
  517. parse arg macro,args,handler
  518.     f=CreateTempFile()
  519.     if f="" then do
  520.         call ErrLog("error macro" macro "returned" rc global.peer)
  521.         return ""
  522.     end
  523.     o=pragma("D",PathPart(macro))
  524.     macro=FilePart(macro)
  525.     select
  526.         when handler="CGI" then cmd="perl <NIL: >"f '"'addpart(pragma(D),macro)'"' args
  527.         when handler="REXX" then cmd="rx <NIL: >"f macro args
  528.         when handler="REBOL" then cmd="work:rebol/rebol -cqw <NIL: >"f macro args
  529.         when handler="EXE" then cmd=macro "<NIL: >"f args
  530.         otherwise cmd=""
  531.     end
  532.     if cmd~="" then do
  533.         global.err5=1
  534.         SHELL COMMAND cmd
  535.         global.err5=0
  536.         call pragma("D",o)
  537.         if rc~=0 then do
  538.             call ErrLog("error macro" macro "returned" rc global.peer)
  539.             f=""
  540.         end
  541.     end
  542.     else f=""
  543.     call pragma("D",o)
  544.     return f
  545. /***************************************************************************/
  546. getHeadString: procedure
  547. parse arg code
  548.     select
  549.         when code=100 then s="Continue"
  550.         when code=101 then s="Switching Protocols"
  551.         when code=200 then s="OK"
  552.         when code=201 then s="Created"
  553.         when code=202 then s="Accepted"
  554.         when code=203 then s="Non-Authoritative Information"
  555.         when code=204 then s="No Content"
  556.         when code=205 then s="Reset Content"
  557.         when code=206 then s="Partial Content"
  558.         when code=300 then s="Multiple Choices"
  559.         when code=301 then s="Moved Permanently"
  560.         when code=302 then s="Moved Temporarily"
  561.         when code=303 then s="See Other"
  562.         when code=304 then s="Not Modified"
  563.         when code=305 then s="Use Proxy"
  564.         when code=400 then s="Bad Request"
  565.         when code=401 then s="Unauthorized"
  566.         when code=402 then s="Payment Required"
  567.         when code=403 then s="Forbidden"
  568.         when code=404 then s="Not Found"
  569.         when code=405 then s="Method Not Allowed"
  570.         when code=406 then s="Not Acceptable"
  571.         when code=407 then s="Proxy Authentication Required"
  572.         when code=408 then s="Request Time-out"
  573.         when code=409 then s="Conflict"
  574.         when code=410 then s="Gone"
  575.         when code=411 then s="Length Required"
  576.         when code=412 then s="Precondition Failed"
  577.         when code=413 then s="Request Entity Too Large"
  578.         when code=414 then s="Request-URI Too Large"
  579.         when code=415 then s="Unsupported Media Type"
  580.         when code=420 then s="No ident service running"
  581.         when code=500 then s="Internal Server Error"
  582.         when code=501 then s="Not Implemented"
  583.         when code=502 then s="Bad Gateway"
  584.         when code=503 then s="Service Unavailable"
  585.         when code=504 then s="Gateway Time-out"
  586.         when code=505 then s="HTTP Version not supported"
  587.         otherwise s="Code:" code
  588.     end
  589.     return "HTTP/1.0" code s
  590. /***************************************************************************/
  591. createHead: procedure expose global.
  592. parse arg code,mime,length,realm,last,cgi
  593.  
  594.     msg=getHeadString(code) || "D0A"x || "Server: hserv/" || global.ver || "D0A"x || "Date:" GMTInetCurrentDate() || "D0A"x
  595.     if realm~="" then msg=msg || "WWW-Authenticate: Basic realm=" || '"' || realm || '"' || "D0A"x
  596.     if length~="" then msg=msg || "Content-Length:" length || "D0A"x
  597.     if last~="" then msg=msg || "Last-Modified:" last || "D0A"x
  598.     if cgi=1 then msg=msg || mime || "D0A"x
  599.     else msg=msg || "Content-Type:" mime || "D0A"x
  600.     msg=msg || "Connection: closed" || "D0A"x
  601.     msg=msg || "D0A"x
  602.     return msg
  603. /***************************************************************************/
  604. parseFileName: procedure expose global.
  605.     if global.file="" then return 400
  606.  
  607.     res = parseURL("GLOBAL.TEMP",global.file)
  608.     if res>0 then return res
  609.     if global.temp.host~="" then do
  610.         if global.host~=global.temp.host | global.hostport~=global.temp.port then return 400
  611.         global.host=global.temp.host
  612.         global.file=global.temp.file
  613.     end
  614.  
  615.     if (index(global.file,"//")~=0) | (index(global.file,":")~=0) then
  616.         return 404
  617.  
  618.     pf=PathPart(global.file)
  619.     if pf="" then return 400
  620.  
  621.     if FilePart(global.file)="" then
  622.         global.file=AddPart(global.file,global.DocumentIndex)
  623.  
  624.     if (global.args="") & (global.post="") then
  625.         global.complete=AddPart(global.DocumentDir,right(global.file,length(global.file)-1))
  626.     else do
  627.         if (global.method~="POST") then
  628.             parse var global.file global.file"?"global.args
  629.     end
  630.  
  631.     if upper(left(pf,8))="/CGI-BIN" then
  632.         global.complete=AddPart(global.CGIDir,FilePart(global.file))
  633.     else
  634.         global.complete=AddPart(global.DocumentDir,right(global.file,length(global.file)-1))
  635.  
  636.     if checkSpecials() then return -1
  637.  
  638.     s=statef(global.complete)
  639.     if word(s,1)~="FILE" then return 404
  640.  
  641.     global.size=word(s,2)
  642.     global.handler=getHandler(global.complete)
  643.  
  644.     return 0
  645. /***************************************************************************/
  646. getHandler: procedure expose global.
  647. parse arg file
  648.     l=lastpos(".",file)
  649.     le=length(file)
  650.     if l~=0 & l~=le then ext=upper(right(file,le-l))
  651.     else ext=""
  652.     select
  653.         when ext="CGI" then res="CGI"
  654.         when ext="REXX" then res="REXX"
  655.         when ext="R" then res="REBOL"
  656.         when ext="" then res="EXE"
  657.         otherwise res="SEND"
  658.     end
  659.     if global.handlers~="" then do
  660.         lines=ParseConfig(global.Handlers,"HANDLERS","SIMPLECOMMENT")
  661.         if lines==-1 then do
  662.             call ErrLog("Handlers file '"global.Handlers"' not found")
  663.             return res
  664.         end
  665.  
  666.         do i=0 to lines-1
  667.             if RMH_match(handlers.i,file) then return handlers.i.value
  668.         end
  669.     end
  670.     return res
  671. /***************************************************************************/
  672. syntax:
  673.     call EasyRequest(ErrorText(rc)d2c(10)"Line:" sigl,"hs Syntax error")
  674.     exit
  675. /***************************************************************************/
  676. error:
  677.     if global.err5 then err="command returned" 5
  678.     else err=ErrorText(rc)
  679.     call EasyRequest(err||d2c(10)"Line:" sigl,"hs Error")
  680.     exit
  681. /***************************************************************************/
  682. hostName: procedure expose global.
  683.     hname=global.HostName
  684.     if hname="" then do
  685.         call GetSockName(global.sock,"N")
  686.         hname=n.AddrAddr
  687.     end
  688.     return hname
  689. /***************************************************************************/
  690. errLog: procedure expose global.
  691. parse arg msg
  692.     select
  693.         when global.ErrorLog="OFF" then return 1
  694.         when global.ErrorLogl="ON" then do
  695.             if ~open("LOG",global.ErrorFile,"A") then
  696.                 if ~open("LOG",ef,"W") then return 0
  697.             call WriteLN("LOG","hs ("global.port")" date() time() msg)
  698.         end
  699.         when global.ErrorLog="SYS" then call SysLog(msg,"INFO")
  700.         otherwise nop
  701.     end
  702.     return 1
  703. /***************************************************************************/
  704. transferLog: procedure expose global.
  705. parse arg msg
  706.     select
  707.         when global.TransferLog="OFF" then return 1
  708.         when global.TransferLog="ON" then do
  709.             if ~open("LOG",tf,"A") then
  710.             if ~open("LOG",global.TransferFile,"W") then return 0
  711.                 call WriteLN("LOG","hs ("global.port")" date() time() msg)
  712.         end
  713.         when global.TransferLog="SYS" then do
  714.             msg=decode(msg)
  715.             call SysLog(msg,"INFO")
  716.         end
  717.         otherwise nop
  718.     end
  719.     return 1
  720. /***************************************************************************/
  721. checkIP: procedure expose global.
  722.     if global.RejectedIP="" then return ""
  723.     lines=ParseConfig(global.RejectedIP,"IPS")
  724.     if lines=-1 then do
  725.         call ErrLog("RejectedIP file '"global.RejectedIP"' not found")
  726.         return ""
  727.     end
  728.  
  729.     do i=0 to lines-1
  730.         patt=RMH_match(ips.i,global.peer) then return ips.i.value
  731.     end
  732.     return ""
  733. /***************************************************************************/
  734. checkAuth: procedure expose global.
  735.     if global.Auth="" then return ""
  736.     lines=ParseConfig(global.Auth,"AL","SIMPLECOMMENT")
  737.     if lines=-1 then do
  738.         call ErrLog("Auth file '"global.Auth"' not found")
  739.         return "Secret World"
  740.     end
  741.  
  742.     do i=0 to lines-1
  743.         if ~RMH_match(al.i,global.complete) then iterate
  744.         parse var al.i.value realm login pass .
  745.         if global.Authorization="" then return realm
  746.         enc=encodeB64(login":"pass)
  747.         if enc=global.Authorization then return ""
  748.         return realm
  749.     end
  750.     return ""
  751. /***************************************************************************/
  752. encodeB64: procedure
  753.     parse arg s
  754.         if length(s)>20 then return ""
  755.         s=c2b(s)
  756.         a=""
  757.         do while s~=""
  758.             parse var s c +6 s
  759.             a=a||substr("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/",c2d(b2c(left(c"0000",6)))+1,1)
  760.         end
  761.         l=length(c)
  762.         if l<6 then a=a||copies("=",(6-l)/2)
  763.         return a
  764. /***************************************************************************/
  765. decode: procedure
  766. parse arg msg
  767.     res=""
  768.     do while pos("%",msg)~=0
  769.         parse var msg a "%" msg
  770.         res = res || a || "%%"
  771.     end
  772.     return res || msg
  773. /***************************************************************************/
  774. getMime: procedure expose global.
  775. parse arg file
  776.     l=lastpos(".",file)
  777.     ll=length(file)
  778.     if l~=0 & l~=ll then ext=upper(right(file,ll-l))
  779.     else ext=""
  780.     if ext=="" | MimeFile=="" then return global.defMime
  781.  
  782.     lines=ParseConfig(global.MimeFile,"MIMES","NOUPPER")
  783.     if lines==-1 then do
  784.         call ErrLog("Mime file '"global.mimeFile"' not found")
  785.         return global.defMime
  786.     end
  787.  
  788.     do i=0 to lines-1
  789.         if find(upper(mimes.i.value),upper(ext))~=0 then return mimes.i
  790.     end
  791.     return global.defMime
  792. /***************************************************************************/
  793. debug: procedure expose global.
  794. parse arg msg
  795.     do i=0 to global.request.num-1
  796.         call SysLog(decode(global.request.i))
  797.     end
  798.     call SysLog(msg)
  799.     return
  800. /***************************************************************************/
  801. GMTInetCurrentDate: procedure expose global.
  802.     call GetDate("D","GMT")
  803.     return translateDate(formatdate("D",global.inetDate))
  804. /***************************************************************************/
  805. GMTInetFileDate: procedure expose global.
  806. parse arg file
  807.     call GetDate("NOW","GMT")
  808.     date="NOW"
  809.     if GetFileDate(file,"FD") then do
  810.         call date2gmt("FD")
  811.         if CompareDates("NOW","FD")<0 then date="FD"
  812.     end
  813.     return translateDate(formatdate(date,global.inetDate))
  814. /***************************************************************************/
  815. translateDate: procedure
  816.     d.0="Sun";d.1="Mon";d.2="Tue";d.3="Wed";d.4="Thu";d.5="Fri";d.6="Sat"
  817.     m.1="Jan";m.2="Feb";m.3="Mar";m.4="Apr";m.5="May";m.6="Jun";m.7="Jul";m.8="Aug";m.9="Sep";m.10="Oct";m.11="Nov";m.12="Dec"
  818.     parse arg i j rest
  819.     i=i%1
  820.     return d.j"," m.i || rest
  821. /***************************************************************************/
  822. checkSince: procedure
  823. parse arg since,file
  824.  
  825.     marray="JANUARY  FEBRUARY MARCH    APRIL    MAY      JUNE     JULY     AUGUST   SEPTEMBEROCTOBER  NOVEMBER DECEMBER"
  826.     darray="SUNDAY   MONDAY   TUESDAY  WEDNESDAYTHURSDAY FRIDAY   SATURDAY"
  827.     fmt="%d %m %Y %H:%M:%S"
  828.     since=upper(since)
  829.  
  830.     date.0='dayname"," month day year hour":"minute":"second'
  831.     date.1='dayname"," day month year hour":"minute":"second'
  832.     date.2='dayname"," day "-" month "-" year hour":"minute":"second'
  833.     date.3='dayname month day hour":"minute":"second year'
  834.  
  835.     found=0
  836.     do i=0 to 3 while ~found
  837.         line="parse var since" date.i "."
  838.         INTERPRET line
  839.  
  840.         if length(dayname)<2 then iterate
  841.         if pos(dayname,darray)=0 then iterate
  842.  
  843.         if length(month)<2 then iterate
  844.         p=pos(month,marray)
  845.         if p=0 then iterate
  846.         month=right(p%9+1,2)
  847.  
  848.         if year<1900 then year=year+1900
  849.         if month~=0 then do
  850.             date = day month year hour":"minute":"second
  851.             found=ParseDate(date,fmt,"SD")
  852.         end
  853.     end
  854.     if ~found then return 1
  855.  
  856.     call GetDate("NOW","GMT")
  857.     call GetFileDate(file,"FD")
  858.     call date2gmt("FD")
  859.  
  860.     if CompareDates("NOW","FD")>0 then return 1
  861.     if CompareDates("NOW","SD")>0 then return 1
  862.  
  863.     fd.tick=fd.tick-fd.tick//100
  864.     sd.tick=sd.tick-sd.tick//100
  865.  
  866.     return CompareDates("FD","SD")<0
  867. /***************************************************************************/
  868. checkSpecials: procedure expose global.
  869.     if global.Specials="" then return 0
  870.     lines=ParseConfig(global.Specials,"SP","SIMPLECOMMENT")
  871.  
  872.     if lines=-1 then do
  873.         call ErrLog("Special file '"global.Specials"' not found")
  874.         return 0
  875.     end
  876.  
  877.     do i=0 to lines-1
  878.         if RMH_match(sp.i,global.complete) then leave
  879.     end
  880.  
  881.     if i=lines then return 0
  882.  
  883.     parse var sp.i.value type " " a " " b
  884.     select
  885.         when type="CODE" then do
  886.             msg=getHeadString(a) || "D0A"x || "Server: hserv/" || global.ver || "D0A"x || "Date:" GMTInetCurrentDate() || "D0A"x
  887.             msg=msg || b || "D0A"x || "D0A"x
  888.             call sen msg
  889.         end
  890.         when type="CALL" then call RXSCall(a b,global.sock,"SYNC")
  891.         otherwise return 0
  892.     end
  893.     return 1
  894. /***************************************************************************/
  895. getVirtualHost: procedure expose global.
  896.     if global.VirtualHosts="" then return 1
  897.     lines=ParseConfig(global.VirtualHosts,"VH","SIMPLECOMMENT")
  898.     if lines=-1 then do
  899.         call ErrLog("Auth file '"global.VirtualHosts"' not found")
  900.         return 0
  901.     end
  902.  
  903.     do i=0 to lines-1
  904.         if RMH_match(vh.i,global.host) then do
  905.             parse var vh.i.value d i .
  906.             if d="" then return 0
  907.             global.DocumentDir=d
  908.             call SetVar("hserv_DocumentDir",d,"LOCAL")
  909.             if i="" then i=global.DocumentIndex
  910.             else do
  911.                 global.DocumentIndex=i
  912.                 call SetVar("hserv_DocumentIndex",i,"LOCAL")
  913.             end
  914.             return 1
  915.         end
  916.     end
  917.     return 1
  918. /***************************************************************************/
  919. include: procedure expose global.
  920.     parse arg file
  921.     if file="" then return "no file given"
  922.     parse var file '"' f '"'
  923.     if f~="" then file=f
  924.     p=PathPart(file)
  925.     if p="" then o=pragma("D",global.DocumentDir)
  926.     else o=pragma("D",p)
  927.  
  928.     if open("INCLUDE",file,"R") then do
  929.         res=""
  930.         do while ~eof("INCLUDE")
  931.             res=res || readln("INCLUDE")
  932.         end
  933.         call close("INCLUDE")
  934.     end
  935.     else res="can't find file '"file"'"
  936.     call pragma("D",o)
  937.     return res
  938. /***************************************************************************/
  939. parseUrl: procedure expose global.
  940. parse arg stem,u
  941.  
  942.     if u="" then return 400
  943.  
  944.     p=80
  945.     f=""
  946.     l=""
  947.     pw=""
  948.  
  949.     pr = match("#?://#?",u)
  950.     if  pr then do
  951.         parse var u proto "://" u
  952.         if upper(left(proto,7))~="HTTP" then return 400
  953.     end
  954.  
  955.     if match("#?:#?@#?",u) then do
  956.         parse var u l":"pw"@"u
  957.         if l="" | pw="" | u="" then return 400
  958.     end
  959.  
  960.     if match("#?/#?",u) then do
  961.         parse var u u "/" f
  962.     end
  963.     f = "/"f
  964.  
  965.     if match("#?:#?",u) then do
  966.         parse var u u ":" p
  967.         if ~DataType(p,"N") then return 400
  968.         if p<1 | p>65535 then return 400
  969.         pr=1
  970.     end
  971.  
  972.     if pr then if u="" then return 400
  973.  
  974.     interpret stem".HOST='"u"'"
  975.     interpret stem".PORT='"p"'"
  976.     interpret stem".FILE='"f"'"
  977.     return 0
  978. /***************************************************************************/
  979. /*$VER: hs.rexx 13.1 (17.5.99)*/
  980.